home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Maint.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.5 KB  |  137 lines  |  [TEXT/R*ch]
  1. (* Main.sml *)
  2.  
  3. open List BasicIO Nonstdio;
  4. open Miscsys Memory Fnlib Config Mixture Location Units Smlperv Rtvals Smltop;
  5.  
  6. val initialFiles = ref ([] : string list);
  7.  
  8. (* Initial loop *)
  9.  
  10. fun initial_loop () =
  11.   while true do
  12.     let in
  13.       msgFlush();
  14.       (case !initialFiles of
  15.            [] =>
  16.              raise Toplevel
  17.          | filename :: rest =>
  18.              (initialFiles := rest;
  19.               evalUse filename))
  20.       handle
  21.           Toplevel =>
  22.             (msgFlush();
  23.              raise EndOfFile)
  24.         | Interrupt =>
  25.             (msgIBlock 0;
  26.              msgPrompt "Interrupted."; msgEOL();
  27.              msgEBlock();
  28.              msgFlush();
  29.              raise EndOfFile)
  30.         | x =>
  31.            (msgFlush();
  32.             raise x)
  33.     end
  34. ;
  35.  
  36. (* Main loop *)
  37.  
  38. fun main_loop () =
  39.   while true do
  40.     let in
  41.       msgFlush();
  42.       outputc std_out toplevel_input_prompt;
  43.       flush_out std_out;
  44.       let val isLast = loadToplevelPhrase (!input_lexbuf) in
  45.         if isLast then raise EndOfFile else ()
  46.       end
  47.       handle
  48.           EndOfFile =>
  49.               (msgIBlock 0; msgEOL(); msgEBlock ();
  50.            msgFlush(); BasicIO.exit 0)
  51.         | Toplevel =>
  52.             msgFlush()
  53.         | Interrupt =>
  54.             (msgIBlock 0;
  55.              msgPrompt "Interrupted.";
  56.              msgEOL(); msgEBlock(); msgFlush())
  57.         | x =>
  58.             (msgFlush();
  59.              raise x)
  60.     end
  61. ;
  62.  
  63. fun anonymous s =
  64.   initialFiles := !initialFiles @ [s]
  65. ;
  66.  
  67. fun set_stdlib p =
  68.   path_library := p;
  69. ;
  70.  
  71. fun set_value_polymorphism b _ =
  72.   value_polymorphism := b;
  73. ;
  74.  
  75. fun add_include d =
  76.   load_path := !load_path @ [d]
  77. ;
  78.  
  79. fun perv_set set =
  80.   (preloadedUnits := lookup (Fnlib.stringToLower set) preloadedUnitSets;
  81.    preopenedPreloadedUnits := lookup (Fnlib.stringToLower set) preopenedPreloadedUnitSets)
  82.   handle Subscript =>
  83.     raise (Arg.Bad ("unknown preloaded unit set " ^ set))
  84. ;
  85.  
  86. fun main () =
  87. (
  88.   msgIBlock 0;
  89.   msgString "Moscow ML version 1.42 (July 1997)";
  90.   msgEOL();
  91.   msgString "Enter `quit();' to quit.";
  92.   msgEOL();
  93.   msgEBlock();
  94.   msgFlush();
  95.   let in
  96.     preloadedUnits := lookup "default" preloadedUnitSets;
  97.     preopenedPreloadedUnits := lookup "default" preopenedPreloadedUnitSets;
  98.     load_path := [];
  99.     toplevel := true;
  100.     (* Choose the default (value polymorphism or imperative types) here: *)
  101.     value_polymorphism := true;
  102.     Arg.parse [("-stdlib",    Arg.String set_stdlib),
  103.                ("-I",         Arg.String add_include),
  104.                ("-include",   Arg.String add_include),
  105.                ("-P",         Arg.String perv_set),
  106.                ("-perv",      Arg.String perv_set),
  107.                ("-imptypes",  Arg.Unit (set_value_polymorphism false)),
  108.                ("-valuepoly", Arg.Unit (set_value_polymorphism true))]
  109.       anonymous;
  110.     if !path_library <> "" then
  111.       load_path := !load_path @ [!path_library]
  112.     else ();
  113.     resetGlobalDynEnv();
  114.     resetSMLTopDynEnv();
  115.     initPervasiveEnvironments();
  116.     setGlobalVal 16 (Obj.repr true); (* 16: cf ../runtime/globals.h *)
  117.     startCompilingUnit "Top";
  118.     app evalLoad (!preloadedUnits);
  119.     initInitialEnvironments();
  120.     execToplevelOpen nilLocation "Meta";
  121.     Miscsys.catch_interrupt true;
  122.     input_lexbuf := Compiler.createLexerStream std_in;
  123.     (initial_loop() handle EndOfFile => ());
  124.     main_loop()
  125.   end
  126.   handle
  127.       Toplevel =>
  128.         (msgFlush(); BasicIO.exit 2)
  129.     | Impossible msg =>
  130.         (msgIBlock 0;
  131.          errPrompt "Internal error: "; msgString msg;
  132.          msgEOL(); msgEBlock(); msgFlush();
  133.          BasicIO.exit 4)
  134. );
  135.  
  136. val () = Printexc.f main ();
  137.